home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-20
/
minimuf1.zip
/
MINIMUF.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-10-14
|
8KB
|
228 lines
10 REM - SAMPLE DRIVER FOR MINIMUF 3.5
12 REM FROM QST DECEMBER 1982 PAGE 36
14 REM Article By Robert B. Rose, K6GKU
16 REM With modifications shown in August, 1983 QST, Page 64. --N6KL
18 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
20 REM * Interface and output routines rewritten on 3/3/87
22 REM * MINIMUF 3.5 (lines 1000-2000) was not changed
24 REM * Martin R. Maltby, Arcata, CA, x6xxx (no call yet!)
26 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
100 REM
102 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
104 REM * I N I T I A L I Z A T I O N
106 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
108 CLEAR 1000
110 U$=" ##:00 ##.# ##:00 ##.#
112 DIM MUF(23)
114 DATA 31,28,31,30,31,30,31,31,30,31,30,31 'Days in months
116 M$="JanFebMarAprMayJunJulAugSepOctNovDec"
118 PI = 3.1415926535#
120 R0=PI/180
122 P1=2*PI
124 R1=180/PI
126 P0=PI/2
200 REM
202 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
204 REM * M A I N , I N P U T S
206 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
208 CLS
210 PRINT "Transmitter latitute ="
212 PRINT "Transmitter longitude ="
214 PRINT
216 PRINT "Receiver latitude ="
218 PRINT "Receiver longitude ="
220 PRINT
222 PRINT "Solar flux from WWV ="
224 PRINT "ON DATE: Month Number ="
226 PRINT " Day Number ="
228 LOCATE 1,25:PRINT " ":LOCATE 1,25
230 LINE INPUT TE$:L1=VAL(TE$)
232 IF L1=>-90 AND L1<=90 THEN 240
234 ER$= "Invalid latitude. Must be in range -90 TO +90." : GOSUB 3100
236 GOTO 228
238 REM ----------------------------
240 LOCATE 2,25:PRINT " ":LOCATE 2,25
242 LINE INPUT TE$: W1=VAL(TE$)
244 IF -360<=W1 AND W1<=360 THEN 252
246 ER$= "Invalid longitude. Must be in range -360 TO +360." : GOSUB 3100
248 GOTO 240
250 REM ----------------------------
252 LOCATE 4,25:PRINT " ":LOCATE 4,25
254 LINE INPUT TE$:L2=VAL(TE$)
256 IF -90<=L2 AND L2<=90 THEN 264
258 ER$= "Invalid latitude. Must be in range -90 TO +90." : GOSUB 3100
260 GOTO 252
262 REM ----------------------------
264 LOCATE 5,25:PRINT " ":LOCATE 5,25
266 LINE INPUT TE$: W2=VAL(TE$)
268 IF -360<=W2 AND W2<=360 THEN 276
270 ER$= "Invalid longitude. Must be in range -360 TO +360." : GOSUB 3100
272 GOTO 264
274 REM -------------------------------------------------------
276 LOCATE 7,25:PRINT " ":LOCATE 7,25
278 LINE INPUT TE$:S9=VAL(TE$)
280 IF S9=>60 THEN 286
282 ER$= "Invalid solar flux. Must be greater then 60." : GOSUB 3100
284 GOTO 276
286 IF S9<250 THEN 294
288 ER$= "Invalid solar flux. Must be less than 250." : GOSUB 3100
290 GOTO 276
292 REM CALCULATE SUNSPOT NUMBER FROM 10.7 CM SOLAR FLUX NUMBER.
294 S9=(S9-60)/.9000001
296 REM ----------------------------
298 LOCATE 8,25:PRINT " ":LOCATE 8,25
300 LINE INPUT TE$:M0=VAL(TE$)
302 IF 1<=M0 AND M0<=12 THEN 308
304 ER$= "Invalid month, must be in range 1 TO 12.": GOSUB 3100
306 GOTO 298
308 LOCATE 9,25:PRINT " ":LOCATE 9,25
310 LINE INPUT TE$:D6=VAL(TE$)
312 RESTORE : FOR Z=1 TO M0 : READ DY : NEXT Z
314 IF D6>=1 AND D6 <= DY THEN 328
316 ER$= "Invalid day. Must be in range: 1 to "+STR$(DY)+"." : GOSUB 3100
318 GOTO 308
320 REM
322 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
324 REM * M A I N , O U T P U T S
326 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
328 A$=MID$(M$,3*M0-2,3)
330 CLS : PRINT "Date: ";D6;A$" Sunspot number : "S9
332 PRINT "Transmitter location: ";
334 PRINT "Latitude ";L1;" Longitude ";W1
336 PRINT "Receiver location: ";
338 PRINT "Latitude ";L2;" Longitude ";W2
340 PRINT
342 PRINT " Hour (UTC) MUF (MHz) Hour (UTC) MUF (MHz)"
344 PRINT
346 L1=L1*R0
348 W1=W1*R0
350 L2=L2*R0
352 W2=W2*R0
354 FOR TE=0 TO 11
356 T5 = TE : GOSUB 1000 : MUF(T5)=J9
358 T5=TE+12: GOSUB 1000 : MUF(T5)=J9
360 PRINT USING U$;TE,MUF(TE),TE+12,MUF(TE+12)
362 NEXT TE
364 PRINT:PRINT
366 PRINT "PRESS: <Shift><PrtSc> to print, or <X> to exit";
368 A$ = INKEY$: IF A$ = "" THEN 368
370 IF (A$<>"x") AND (A$<>"X") THEN 208
372 END
1000 REM
1010 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1020 REM * M I N I M U F 3 . 5
1030 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1040 REM * REQUIRES:
1050 REM *
1060 REM * L1, W1 = Transmitter Lattitude*(PI/180), Longitude*(PI/180)
1070 REM * L2, W2 = Reciever Lattitude*(PI/180), Longitude*(PI/180)
1080 REM * S9 = "sunspot number from 10.7 cm solar flux number"
1090 REM *
1100 REM * M0 = Month #
1110 REM * D6 = Day #
1120 REM * T5 = Hour #
1130 REM *
1140 REM *
1150 REM * RETURNS: MUF for hour(T5) in J9
1160 REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1170 REM - MINIMUF 3.5
1180 K7=SIN(L1)*SIN(L2)+COS(L1)*COS(L2)*COS(W2-W1)
1190 IF K7=>-1 THEN 1220
1200 K7=-1
1210 GOTO 1240
1220 IF K7<=1 THEN 1240
1230 K7=1
1240 G1=1.5708-2*ATN(K7/(1+SQR(1-K7*K7)))
1250 K6=1.59*G1
1260 IF K6>=1 THEN 1280
1270 K6=1
1280 K5=1/K6
1290 J9=100
1300 FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP .9999-1/K6
1310 IF K5=1 THEN 1330
1320 K5=.5
1330 P=SIN(L2)
1340 Q=COS(L2)
1350 A=(SIN(L1)-P*COS(G1))/(Q*SIN(G1))
1360 B=G1*K1
1370 C=P*COS(B)+Q*SIN(B)*A
1380 D=(COS(B)-C*P)/(Q*SQR(1-C^2))
1390 IF D=>-1 THEN 1420
1400 D=-1
1410 GOTO 1440
1420 IF D<=1 THEN 1440
1430 D=1
1440 D=1.5708-2*ATN(D/(1+SQR(1-D*D)))
1450 W0=W2+SGN(SIN(W1-W2))*D
1460 IF W0=>0 THEN 1480
1470 W0=W0+P1
1480 IF W0<P1 THEN 1500
1490 W0=W0-P1
1500 IF C=>-1 THEN 1530
1510 C=-1
1520 GOTO 1550
1530 IF C<=1 THEN 1550
1540 C=1
1550 L0=P0-(1.5708-2*ATN(C/(1+SQR(1-C*C))))
1560 Y1=.0172*(10+(M0-1)*30.4+D6)
1570 Y2=.409*COS(Y1)
1580 K8=3.82*W0+12+.13*(SIN(Y1)+1.2*SIN(2*Y1))
1590 IF COS(L0+Y2)>-.26 THEN 1680
1600 K9=0
1610 G0=0
1620 M9=2.5*G1*K5
1630 IF M9<=P0 THEN 1650
1640 M9=P0
1650 M9=SIN(M9)
1660 M9=1+2.5*M9*SQR(M9)
1670 GOTO 1930
1680 K9=(-.26+SIN(Y2)*SIN(L0))/(COS(Y2)*COS(L0)+9.999999E-04)
1690 K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.639437
1700 T=K8-K9/2+12*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2))
1710 T4=K8+K9/2-12*(1+SGN(K8+K9/2-24))*SGN(ABS(K8+K9/2-24))
1720 C0=ABS(COS(L0+Y2))
1730 T9=9.7*C0^9.600001
1740 IF T9>0 THEN 1760
1750 T9=.1
1760 M9=2.5*G1*K5
1770 IF M9<P0 THEN 1790
1780 M9=P0
1790 M9=SIN(M9)
1800 M9=1+2.5*M9*SQR(M9)
1810 IF T4<T THEN 1840
1820 IF (T5-T)*(T4-T5)>0 THEN 1850
1830 GOTO 1980
1840 IF (T5-T4)*(T-T5)>0 THEN 1980
1850 T6=T5+12*(1+SGN(T-T5))*SGN(ABS(T-T5))
1860 G9=3.14159*(T6-T)/K9
1870 G8=3.14159*T9/K9
1880 U=(T-T6)/T9
1890 G0=C0*(SIN(G9)+G8*(EXP(U)-COS(G9)))/(1+G8*G8)
1900 G7=C0*(G8*(EXP(-K9/T9)+1))*EXP((K9-24)/2)/(1+G8*G8)
1910 IF G0=>G7 THEN 1930
1920 G0=G7
1930 G2=(1+S9/250)*M9*SQR(6+58*SQR(G0))
1940 G2=G2*(1-.1*EXP((K9-24)/3))
1950 G2=G2*(1+(1-SGN(L1)*SGN(L2))*.1)
1960 G2=G2*(1-.1*(1+SGN(ABS(SIN(L0))-COS(L0))))
1970 GOTO 2040
1980 T6=T5+12*(1+SGN(T4-T5))*SGN(ABS(T4-T5))
1990 G8=3.14159*T9/K9
2000 U=(T4-T6)/2
2010 U1=-K9/T9
2020 G0=C0*(G8*(EXP(U1)+1))*EXP(U)/(1+G8*G8)
2030 GOTO 1930
2040 IF G2>J9 THEN 2060
2050 J9=G2
2060 NEXT K1
2070 RETURN
3000 REM ummmm, OUTPUT ROUTINES
3100 LOCATE 22,1:BEEP
3110 PRINT ER$
3120 PRINT "-= Press any key to continue =-"
3130 IF INKEY$="" THEN 3130
3140 LOCATE 22,1
3150 PRINT" "
3160 PRINT" "
3170 RETURN